package clreqd_cmdsxml;

#########################################################################
# Perl Object Module to load in the details of the cluster request	#
# daemon commands XML file - which defines which requests are accepted	#
# on which hosts, and arguments that are optional or mandatory.		#
#########################################################################

use XML::Parser;
use Carp qw(cluck);
use strict;

my $error_str=undef;
my $logmsg_hdlr=undef;
my $warnmsg_hdlr=undef;

sub error {
	return $error_str;
}

sub set_logmsg_hdlr {
	$logmsg_hdlr=$_[0];
}

sub set_warnmsg_hdlr {
	$warnmsg_hdlr=$_[0];
}

sub msg {
	if($_[0] eq "log" && defined($logmsg_hdlr)) {
		&{$logmsg_hdlr}($_[1]);
	}
	if($_[0] eq "warn" && defined($warnmsg_hdlr)) {
		&{$logmsg_hdlr}($_[1]);
	}
}

#########################################################################
# Class methods:							#
# ==============							#
# error - return latest error string or undef if everything was OK.	#
# set_logmsg_hdlr -  the routine to call to log a message - no logging	#
# 		     occurs if not set.					#
# set_warnmsg_hdlr - Issue a warning message via this routine - if	#
#		     available.						#
#########################################################################

#########################################################################
# 									#
# The new method will load in the object or set the error condition.	#
# Only following arguement is expect, and will not default it not set.	#
#									#
# filename	The name of the cluster configuration file.		#
#									#
#########################################################################

sub new {
local $clreqd_cmdsxml::self;
local $clreqd_cmdsxml::__chardata;
my $class=shift;
my $file=$_[0];

	if(!defined($file)) {
		cluck("Missing mandatory filename argument.") if $::DEBUG;
		$error_str="Missing mandatory filename argument.";
		return undef;
	}

	if(! -e $file) {
		cluck("File $file does not exist.") if $::DEBUG;
		$error_str="File $file does not exist.";
		return undef;
	}
	if(! -f $file) {
		cluck("Object $file is not a regular file.") if $::DEBUG;
		$error_str="Object $file is not a regular file.";
		return undef;
	}
	# my @s=stat(_);
	# if($s[2] & 07777 != 0600) {
		# cluck("Request Daemon commands file $file must have 0600 permissions!") if $::DEBUG;
		# $error_str="Request Daemon commands file $file must have 0600 permissions!";
		# return undef;
	# }

	#################################################################
	# Now load in the XML using the XML::Parser - not XML simple.	#
	#################################################################
	
	$clreqd_cmdsxml::self={};
	my $p;
	$p = new XML::Parser(
			Handlers => { Start => \&lc_handle_start,
					End => \&lc_handle_end,
				       Char => \&lc_handle_char },
			ErrorContext => 5
		);
	$error_str=undef;
	$p->parsefile($file);
	if(defined($error_str)) {
		cluck($error_str) if $::DEBUG;
		return undef;
	}
	if(!defined($clreqd_cmdsxml::self->{REQUESTS})) {
		cluck("Configuration file missing one or more 'request' elements.") if $::DEBUG;
		$error_str="Configuration file missing one or more 'request' elements.";
		return undef;
	}
	bless($clreqd_cmdsxml::self,$class);
	return $clreqd_cmdsxml::self;
}

sub lc_handle_start {
my $parser=shift;
my $element=shift;
my %attrs=(@_);
my @context=$parser->context;
my @required=qw(name hosts text routine);
my @optional=qw(mandatory optional);

	$element="\U$element";
	$clreqd_cmdsxml::__chardata="";

	return if $element eq "CLREQD_CMDS";
	if($element eq "REQUEST") {
		my @missing=();
		my @unknown=();
		my $ckey;

		#########################################################
		# Search for mandatory attribues and abort if not	#
		# found.						#
		#########################################################

		my @M=(); my %had=(); my @U=();
		foreach $ckey (@required) {
			if(!exists($attrs{$ckey})) {
				push @M,$ckey;
			} else {
				$had{$ckey}=$attrs{$ckey};
				delete $attrs{$ckey};
			}
		}
		if(@M) {
			$error_str="'request' element missing mandatory attributes: " . join(",",@M) . ".";
			$parser->finish;
			return;
		}

		#########################################################
		# Now extract any optional entries from attributes.	#
		#########################################################
		foreach $ckey (@optional) {
			if(exists($attrs{$ckey})) {
				$had{$ckey}=$attrs{$ckey};
				delete $attrs{$ckey};
			}
		}
		if(scalar(keys(%attrs))) {
			$error_str="Unknown attributes specified in 'request' element: " . join(",",sort(keys(%attrs))) . ".";
			$parser->finish;
			return;
		}

		#########################################################
		# How had contains all the attributs so generate	#
		# record based on them.					#
		#########################################################
		my $n=$had{name};
		$clreqd_cmdsxml::self->{REQUESTS}->{$n}={};
		$n=$clreqd_cmdsxml::self->{REQUESTS}->{$n};
		foreach $ckey (keys(%had)) {
			$n->{$ckey}=$had{$ckey};
		}
		return;
	}
	$error_str="Unrecognised element '$element' in XML file!";
	$parser->finish;
}

sub lc_handle_end {
my $parser=shift;
my $element=shift;

	$clreqd_cmdsxml::__chardata =~ s/^\s+//g;	# Get rid of leading white
	$clreqd_cmdsxml::__chardata =~ s/\s+$//g;	# Get rid of trailing white space
	$clreqd_cmdsxml::__chardata =~ s/\n+$//g;	# Get rid of newlines white space
	if(length($clreqd_cmdsxml::__chardata)) {
		$error_str="No character data supported for XML format.";
		$parser->finish;
	}
}

sub lc_handle_char {
my $parser=shift;
my $str=shift;

	$clreqd_cmdsxml::__chardata.=$str;
	return ;
}

sub get_request_list {
my $self=shift;
	return (sort(keys(%{$self->{REQUESTS}})));
}

sub get_request_ref {
my $self=shift;
my $request=shift;
	return(undef) if !exists($self->{REQUESTS}->{$request});
	return $self->{REQUESTS}->{$request};
}

1;
